detection.info = TRUE, target.weights = NULL, source.weights = NULL, C0 = 2, ...) {
transfer.source.id.ori <- transfer.source.id
data <- c(target, source) # to be updated
k <- NULL
lambda.fit <- c(transfer = NA, debias = NA)
if (is.null(target.weights)) {
target.weights <- rep(1, length(target$y))
}
if (is.null(source.weights)) {
source.weights <- sapply(1:length(source), function(i){
rep(1, length(source[[i]]$y))
}, simplify = FALSE)
}
if (!is.null(source) && (is.string(transfer.source.id) && transfer.source.id == "all")) { # transfer all source data
transfer.source.id <- 1:length(source)
} else if (!is.null(source) && is.string(transfer.source.id) && transfer.source.id == "auto") { # automatically check which source data set to transfer
A <- source_detection(target = target, family = family, source = source, alpha = alpha,
cores = cores,  lambda = lambda["detection"], valid.proportion = valid.proportion,
valid.nfolds = valid.nfolds, detection.info = detection.info, standardize = standardize,
intercept = intercept, nfolds = nfolds, target.weights = target.weights, source.weights = source.weights, C0 = C0, ...)
transfer.source.id <- A$transfer.source.id
} else if (0 %in% transfer.source.id || is.null(source)) { # don't transfer any source
transfer.source.id <- 0
}
# step 1
# --------------------------------------
all.x <- as.matrix(foreach(k = unique(c(transfer.source.id)), .combine = "rbind") %do% {
if (k != 0) {
source[[k]]$x
} else {
target$x
}
})
all.y <- foreach(k = unique(c(transfer.source.id)), .combine = "c") %do% {
if (k != 0) {
source[[k]]$y
} else {
target$y
}
}
p <- ncol(all.x)
if (cores > 1) {
registerDoParallel(cores)
}
w <- Reduce("c", sapply(unique(c(0, transfer.source.id)), function(k){
if (k != 0) {
source.weights[[k]]
} else {
target.weights
}
}, simplify = FALSE))
n.try <- 0
while (T) {
cv.fit.trans <- try(cv.glmnet(x = all.x, y = all.y, type.measure="class", nfolds = 5,family = family, alpha = 1,lambda.min.ratio = 0.01,
intercept=FALSE , standardize=FALSE ), silent = T)
if (class(cv.fit.trans) != "try-error") {
break
}
n.try <- n.try + 1
print(paste("tried", n.try, "times during step 1!"))
if (n.try > 10) {
stop("errors during step 1!!!")
}
}
cv.fit.trans1se=glmnet(x = all.x, y = all.y, type.measure="class",family = family, alpha = 1,
intercept=FALSE, standardize=FALSE,lambda=cv.fit.trans$lambda.1se)
wa <- as.matrix(do.call(cbind, coef(cv.fit.trans1se)))
# step 2
offset <- (as.matrix(target$x) %*% wa[-1,])+wa[1,]
if(is.null(cus_value)){
n.try <- 0
while (T) {
cv.fit.correct <- try(cv.glmnet(x = as.matrix(target$x), y = target$y, type.measure="class", nfolds=5,family = family, alpha = 1,offset = offset,lambda.min.ratio = 0.01,
intercept = FALSE, standardize = FALSE), silent=TRUE)
if (class(cv.fit.correct) != "try-error") {
break
}
n.try <- n.try + 1
if (n.try > 10) {
stop("Errors occur during the Step 2!!!")
}
}
}
else{
cv.fit.correct =glmnet(x = as.matrix(target$x), y = target$y, weights = target.weights, offset = offset, family = family, alpha =1,
intercept = FALSE, standardize = FALSE,lambda=cus_value,maxit=10^6)
}
deltaa <- as.matrix(do.call(cbind, coef(cv.fit.correct)))
beta.hat <- wa + deltaa
if(cores > 1) {
stopImplicitCluster()
}
return(beta.hat)
}
# Normalize A
normalize <- function(A) {
if (nrow(A) != ncol(A)) {
stop("Adjacency matrix must be square.")
}
degrees <- rowSums(A)
D <- diag(degrees^(-0.5))
S=D%*%A%*%D
return(S)
}
#This repository is the official implementation
#of ICLR 2025 submitted paper entitled
#Transfer Learning Under High-Dimensional Graph
#Convolutional Regression Model for Node
#Classification
source("TransGCR_function.R")
############################################
################example code################
############################################
#target data
n_samples=200
n_features=50
features=500
n_classes= 3
ERp_t=0.05
g_target =  erdos.renyi.game(n_samples, ERp_t)
A_target = as.matrix(get.adjacency(g_target))
A_target=normalize(A_target+diag(n_samples))
#A_target =   (A_target+diag(n_samples))/sqrt(n_samples*ERp_t)
#A_target =   (A_target+diag(n_samples))/(n_samples*ERp_t)
x <- matrix(rnorm(n_samples * features,0,1),nrow=n_samples,ncol=features)
adjusted_X_target = A_target %*% x
# Generate a coefficient matrix beta
beta1 <- matrix(1,ncol=n_features, nrow=1)
beta2 <- matrix(1.5,ncol=n_features, nrow=1)
beta3 <- matrix(1.6,ncol=n_features, nrow=1)
beta=rbind(beta1,beta2,beta3)
betaN <- matrix(0, nrow=n_classes,ncol = features)
betaN[,1:n_features]=beta
betaN_true=betaN
# Calculate the logits (linear combination of X and beta)
logits <- adjusted_X_target %*% t(betaN)
# Apply the softmax function to convert logits to probabilities
probs <- apply(logits, 1, function(x) exp(x) / sum(exp(x)))
# Generate multinomial distribution
Y=t(apply(probs, 2, function(p) rmultinom(1, size = 1, prob = p)))
y <- apply(Y, 1, which.max)
table(y)
target <- list(x = NULL, y = NULL)
target$x= adjusted_X_target
target$y=y
source=NULL
####source data
for(k in 1:10){
n_samples=100
n_features=50
features=500
n_classes= 3
ERp_ss=0.05
h=0.5
ss=15
g_source =  erdos.renyi.game(n_samples, ERp_ss)
A_source = as.matrix(get.adjacency(g_source))
A_source=normalize(A_source+diag(n_samples))
#A_source =  (A_source+diag(n_samples))/sqrt(n_samples*ERp_ss)
#A_source =  (A_source+diag(n_samples))/(n_samples*ERp_ss)
x <- matrix(rnorm(n_samples * features,0,1),nrow=n_samples,ncol=features)
adjusted_X_source = A_source %*% x
# Generate a coefficient matrix beta
beta1 <- matrix(1,ncol=n_features, nrow=1)
beta2 <- matrix(1.5,ncol=n_features, nrow=1)
beta3 <- matrix(1.6,ncol=n_features, nrow=1)
beta=rbind(beta1,beta2,beta3)
betaN <- matrix(0, nrow=n_classes,ncol = features)
betaN[,1:n_features]=beta
betaN[2,sample(features,ss,replace = FALSE)] =betaN[2,sample(features,ss,replace = FALSE)]- rep(h, ss)
betaN[3,sample(features,ss,replace = FALSE)] =betaN[3,sample(features,ss,replace = FALSE)]+ rep(h, ss)
# Calculate the logits (linear combination of X and beta)
logits <- adjusted_X_source %*% t(betaN)
# Apply the softmax function to convert logits to probabilities
probs <- apply(logits, 1, function(x) exp(x) / sum(exp(x)))
# Generate multinomial distribution
Y=t(apply(probs, 2, function(p) rmultinom(1, size = 1, prob = p)))
y <- apply(Y, 1, which.max)
table(y)
source[[k]]=list(x = NULL, y = NULL)
source[[k]]$x=adjusted_X_source
source[[k]]$y= y
}
##Trans-GCR
beta_sgc=transgcmlr(target,source)
#calculate MSE
m=beta_sgc[-1,]
estimate1=m[,2]-m[,1]
true1=(betaN_true[2,]-betaN_true[1,])
estimate2=m[,3]-m[,1]
true2=(betaN_true[3,]-betaN_true[1,])
MSE_TL= (sum((estimate1- true1) ** 2)+sum((estimate2- true2) ** 2))/(2*features)
##GCR
fit.lasso_TO=cv.glmnet(x = target$x, y = target$y, type.measure="class", nfolds = 5,family = "multinomial", alpha = 1,
intercept = FALSE, standardize = FALSE)
fit=glmnet(x = target$x, y = target$y, family = "multinomial",alpha=1,lambda=fit.lasso_TO$lambda.min
,intercept = FALSE,standardize = FALSE,maxit=10^6)
#calculate MSE
m=coef(fit)
estimate1=m[[2]][-1]-m[[1]][-1]
true1=(betaN_true[2,]-betaN_true[1,])
estimate2=m[[3]][-1]-m[[1]][-1]
true2=(betaN_true[3,]-betaN_true[1,])
MSE_TO = (sum((estimate1- true1) ** 2)+sum((estimate2- true2) ** 2))/(2*features)
MSE_TL
MSE_TO
#This repository is the official implementation
#of ICLR 2025 submitted paper entitled
#Transfer Learning Under High-Dimensional Graph
#Convolutional Regression Model for Node
#Classification
source("TransGCR_function.R")
############################################
################example code################
############################################
#target data
n_samples=200
n_features=50
features=500
n_classes= 3
ERp_t=0.05
g_target =  erdos.renyi.game(n_samples, ERp_t)
A_target = as.matrix(get.adjacency(g_target))
A_target=normalize(A_target+diag(n_samples))
#A_target =   (A_target+diag(n_samples))/sqrt(n_samples*ERp_t)
#A_target =   (A_target+diag(n_samples))/(n_samples*ERp_t)
x <- matrix(rnorm(n_samples * features,0,1),nrow=n_samples,ncol=features)
adjusted_X_target = A_target %*% x
# Generate a coefficient matrix beta
beta1 <- matrix(1,ncol=n_features, nrow=1)
beta2 <- matrix(1.5,ncol=n_features, nrow=1)
beta3 <- matrix(1.6,ncol=n_features, nrow=1)
beta=rbind(beta1,beta2,beta3)
betaN <- matrix(0, nrow=n_classes,ncol = features)
betaN[,1:n_features]=beta
betaN_true=betaN
# Calculate the logits (linear combination of X and beta)
logits <- adjusted_X_target %*% t(betaN)
# Apply the softmax function to convert logits to probabilities
probs <- apply(logits, 1, function(x) exp(x) / sum(exp(x)))
# Generate multinomial distribution
Y=t(apply(probs, 2, function(p) rmultinom(1, size = 1, prob = p)))
y <- apply(Y, 1, which.max)
table(y)
target <- list(x = NULL, y = NULL)
target$x= adjusted_X_target
target$y=y
source=NULL
####source data
for(k in 1:10){
n_samples=100
n_features=50
features=500
n_classes= 3
ERp_ss=0.05
h=0.5
ss=15
g_source =  erdos.renyi.game(n_samples, ERp_ss)
A_source = as.matrix(get.adjacency(g_source))
A_source=normalize(A_source+diag(n_samples))
#A_source =  (A_source+diag(n_samples))/sqrt(n_samples*ERp_ss)
#A_source =  (A_source+diag(n_samples))/(n_samples*ERp_ss)
x <- matrix(rnorm(n_samples * features,0,1),nrow=n_samples,ncol=features)
adjusted_X_source = A_source %*% x
# Generate a coefficient matrix beta
beta1 <- matrix(1,ncol=n_features, nrow=1)
beta2 <- matrix(1.5,ncol=n_features, nrow=1)
beta3 <- matrix(1.6,ncol=n_features, nrow=1)
beta=rbind(beta1,beta2,beta3)
betaN <- matrix(0, nrow=n_classes,ncol = features)
betaN[,1:n_features]=beta
betaN[2,sample(features,ss,replace = FALSE)] =betaN[2,sample(features,ss,replace = FALSE)]- rep(h, ss)
betaN[3,sample(features,ss,replace = FALSE)] =betaN[3,sample(features,ss,replace = FALSE)]+ rep(h, ss)
# Calculate the logits (linear combination of X and beta)
logits <- adjusted_X_source %*% t(betaN)
# Apply the softmax function to convert logits to probabilities
probs <- apply(logits, 1, function(x) exp(x) / sum(exp(x)))
# Generate multinomial distribution
Y=t(apply(probs, 2, function(p) rmultinom(1, size = 1, prob = p)))
y <- apply(Y, 1, which.max)
table(y)
source[[k]]=list(x = NULL, y = NULL)
source[[k]]$x=adjusted_X_source
source[[k]]$y= y
}
##Trans-GCR
beta_sgc=transgcmlr(target,source)
#calculate MSE
m=beta_sgc[-1,]
estimate1=m[,2]-m[,1]
true1=(betaN_true[2,]-betaN_true[1,])
estimate2=m[,3]-m[,1]
true2=(betaN_true[3,]-betaN_true[1,])
MSE_TL= (sum((estimate1- true1) ** 2)+sum((estimate2- true2) ** 2))/(2*features)
##GCR
fit.lasso_TO=cv.glmnet(x = target$x, y = target$y, type.measure="class", nfolds = 5,family = "multinomial", alpha = 1,
intercept = FALSE, standardize = FALSE)
fit=glmnet(x = target$x, y = target$y, family = "multinomial",alpha=1,lambda=fit.lasso_TO$lambda.min
,intercept = FALSE,standardize = FALSE,maxit=10^6)
#calculate MSE
m=coef(fit)
estimate1=m[[2]][-1]-m[[1]][-1]
true1=(betaN_true[2,]-betaN_true[1,])
estimate2=m[[3]][-1]-m[[1]][-1]
true2=(betaN_true[3,]-betaN_true[1,])
MSE_TO = (sum((estimate1- true1) ** 2)+sum((estimate2- true2) ** 2))/(2*features)
MSE_TL
MSE_TO
#This repository is the official implementation
#of ICLR 2025 submitted paper entitled
#Transfer Learning Under High-Dimensional Graph
#Convolutional Regression Model for Node
#Classification
source("TransGCR_function.R")
############################################
################example code################
############################################
#target data
n_samples=200
n_features=50
features=500
n_classes= 3
ERp_t=0.05
g_target =  erdos.renyi.game(n_samples, ERp_t)
A_target = as.matrix(get.adjacency(g_target))
A_target=normalize(A_target+diag(n_samples))
#A_target =   (A_target+diag(n_samples))/sqrt(n_samples*ERp_t)
#A_target =   (A_target+diag(n_samples))/(n_samples*ERp_t)
x <- matrix(rnorm(n_samples * features,0,1),nrow=n_samples,ncol=features)
adjusted_X_target = A_target %*% x
# Generate a coefficient matrix beta
beta1 <- matrix(1,ncol=n_features, nrow=1)
beta2 <- matrix(1.5,ncol=n_features, nrow=1)
beta3 <- matrix(1.6,ncol=n_features, nrow=1)
beta=rbind(beta1,beta2,beta3)
betaN <- matrix(0, nrow=n_classes,ncol = features)
betaN[,1:n_features]=beta
betaN_true=betaN
# Calculate the logits (linear combination of X and beta)
logits <- adjusted_X_target %*% t(betaN)
# Apply the softmax function to convert logits to probabilities
probs <- apply(logits, 1, function(x) exp(x) / sum(exp(x)))
# Generate multinomial distribution
Y=t(apply(probs, 2, function(p) rmultinom(1, size = 1, prob = p)))
y <- apply(Y, 1, which.max)
table(y)
target <- list(x = NULL, y = NULL)
target$x= adjusted_X_target
target$y=y
source=NULL
####source data
for(k in 1:10){
n_samples=100
n_features=50
features=500
n_classes= 3
ERp_ss=0.05
h=0.5
ss=15
g_source =  erdos.renyi.game(n_samples, ERp_ss)
A_source = as.matrix(get.adjacency(g_source))
A_source=normalize(A_source+diag(n_samples))
#A_source =  (A_source+diag(n_samples))/sqrt(n_samples*ERp_ss)
#A_source =  (A_source+diag(n_samples))/(n_samples*ERp_ss)
x <- matrix(rnorm(n_samples * features,0,1),nrow=n_samples,ncol=features)
adjusted_X_source = A_source %*% x
# Generate a coefficient matrix beta
beta1 <- matrix(1,ncol=n_features, nrow=1)
beta2 <- matrix(1.5,ncol=n_features, nrow=1)
beta3 <- matrix(1.6,ncol=n_features, nrow=1)
beta=rbind(beta1,beta2,beta3)
betaN <- matrix(0, nrow=n_classes,ncol = features)
betaN[,1:n_features]=beta
betaN[2,sample(features,ss,replace = FALSE)] =betaN[2,sample(features,ss,replace = FALSE)]- rep(h, ss)
betaN[3,sample(features,ss,replace = FALSE)] =betaN[3,sample(features,ss,replace = FALSE)]+ rep(h, ss)
# Calculate the logits (linear combination of X and beta)
logits <- adjusted_X_source %*% t(betaN)
# Apply the softmax function to convert logits to probabilities
probs <- apply(logits, 1, function(x) exp(x) / sum(exp(x)))
# Generate multinomial distribution
Y=t(apply(probs, 2, function(p) rmultinom(1, size = 1, prob = p)))
y <- apply(Y, 1, which.max)
table(y)
source[[k]]=list(x = NULL, y = NULL)
source[[k]]$x=adjusted_X_source
source[[k]]$y= y
}
##Trans-GCR
beta_sgc=transgcmlr(target,source)
#calculate MSE
m=beta_sgc[-1,]
estimate1=m[,2]-m[,1]
true1=(betaN_true[2,]-betaN_true[1,])
estimate2=m[,3]-m[,1]
true2=(betaN_true[3,]-betaN_true[1,])
MSE_TL= (sum((estimate1- true1) ** 2)+sum((estimate2- true2) ** 2))/(2*features)
##GCR
fit.lasso_TO=cv.glmnet(x = target$x, y = target$y, type.measure="class", nfolds = 5,family = "multinomial", alpha = 1,
intercept = FALSE, standardize = FALSE)
fit=glmnet(x = target$x, y = target$y, family = "multinomial",alpha=1,lambda=fit.lasso_TO$lambda.min
,intercept = FALSE,standardize = FALSE,maxit=10^6)
#calculate MSE
m=coef(fit)
estimate1=m[[2]][-1]-m[[1]][-1]
true1=(betaN_true[2,]-betaN_true[1,])
estimate2=m[[3]][-1]-m[[1]][-1]
true2=(betaN_true[3,]-betaN_true[1,])
MSE_TO = (sum((estimate1- true1) ** 2)+sum((estimate2- true2) ** 2))/(2*features)
MSE_TL
MSE_TO
#This repository is the official implementation
#of ICLR 2025 submitted paper entitled
#Transfer Learning Under High-Dimensional Graph
#Convolutional Regression Model for Node
#Classification
source("TransGCR_function.R")
############################################
################example code################
############################################
#target data
n_samples=200
n_features=50
features=500
n_classes= 3
ERp_t=0.05
g_target =  erdos.renyi.game(n_samples, ERp_t)
A_target = as.matrix(get.adjacency(g_target))
A_target=normalize(A_target+diag(n_samples))
#A_target =   (A_target+diag(n_samples))/sqrt(n_samples*ERp_t)
#A_target =   (A_target+diag(n_samples))/(n_samples*ERp_t)
x <- matrix(rnorm(n_samples * features,0,1),nrow=n_samples,ncol=features)
adjusted_X_target = A_target %*% x
# Generate a coefficient matrix beta
beta1 <- matrix(1,ncol=n_features, nrow=1)
beta2 <- matrix(1.5,ncol=n_features, nrow=1)
beta3 <- matrix(1.6,ncol=n_features, nrow=1)
beta=rbind(beta1,beta2,beta3)
betaN <- matrix(0, nrow=n_classes,ncol = features)
betaN[,1:n_features]=beta
betaN_true=betaN
# Calculate the logits (linear combination of X and beta)
logits <- adjusted_X_target %*% t(betaN)
# Apply the softmax function to convert logits to probabilities
probs <- apply(logits, 1, function(x) exp(x) / sum(exp(x)))
# Generate multinomial distribution
Y=t(apply(probs, 2, function(p) rmultinom(1, size = 1, prob = p)))
y <- apply(Y, 1, which.max)
table(y)
target <- list(x = NULL, y = NULL)
target$x= adjusted_X_target
target$y=y
source=NULL
####source data
for(k in 1:10){
n_samples=100
n_features=50
features=500
n_classes= 3
ERp_ss=0.05
h=0.5
ss=15
g_source =  erdos.renyi.game(n_samples, ERp_ss)
A_source = as.matrix(get.adjacency(g_source))
A_source=normalize(A_source+diag(n_samples))
#A_source =  (A_source+diag(n_samples))/sqrt(n_samples*ERp_ss)
#A_source =  (A_source+diag(n_samples))/(n_samples*ERp_ss)
x <- matrix(rnorm(n_samples * features,0,1),nrow=n_samples,ncol=features)
adjusted_X_source = A_source %*% x
# Generate a coefficient matrix beta
beta1 <- matrix(1,ncol=n_features, nrow=1)
beta2 <- matrix(1.5,ncol=n_features, nrow=1)
beta3 <- matrix(1.6,ncol=n_features, nrow=1)
beta=rbind(beta1,beta2,beta3)
betaN <- matrix(0, nrow=n_classes,ncol = features)
betaN[,1:n_features]=beta
betaN[2,sample(features,ss,replace = FALSE)] =betaN[2,sample(features,ss,replace = FALSE)]- rep(h, ss)
betaN[3,sample(features,ss,replace = FALSE)] =betaN[3,sample(features,ss,replace = FALSE)]+ rep(h, ss)
# Calculate the logits (linear combination of X and beta)
logits <- adjusted_X_source %*% t(betaN)
# Apply the softmax function to convert logits to probabilities
probs <- apply(logits, 1, function(x) exp(x) / sum(exp(x)))
# Generate multinomial distribution
Y=t(apply(probs, 2, function(p) rmultinom(1, size = 1, prob = p)))
y <- apply(Y, 1, which.max)
table(y)
source[[k]]=list(x = NULL, y = NULL)
source[[k]]$x=adjusted_X_source
source[[k]]$y= y
}
##Trans-GCR
beta_sgc=transgcmlr(target,source)
#calculate MSE
m=beta_sgc[-1,]
estimate1=m[,2]-m[,1]
true1=(betaN_true[2,]-betaN_true[1,])
estimate2=m[,3]-m[,1]
true2=(betaN_true[3,]-betaN_true[1,])
MSE_TL= (sum((estimate1- true1) ** 2)+sum((estimate2- true2) ** 2))/(2*features)
##GCR
fit.lasso_TO=cv.glmnet(x = target$x, y = target$y, type.measure="class", nfolds = 5,family = "multinomial", alpha = 1,
intercept = FALSE, standardize = FALSE)
fit=glmnet(x = target$x, y = target$y, family = "multinomial",alpha=1,lambda=fit.lasso_TO$lambda.min
,intercept = FALSE,standardize = FALSE,maxit=10^6)
#calculate MSE
m=coef(fit)
estimate1=m[[2]][-1]-m[[1]][-1]
true1=(betaN_true[2,]-betaN_true[1,])
estimate2=m[[3]][-1]-m[[1]][-1]
true2=(betaN_true[3,]-betaN_true[1,])
MSE_TO = (sum((estimate1- true1) ** 2)+sum((estimate2- true2) ** 2))/(2*features)
MSE_TL
MSE_TO
